#!/usr/local/bin/perl
#
# This assumes one-to-one communication
#
use strict; use warnings;
no if $] >= 5.018, warnings => "experimental::smartmatch";
use feature qw/switch say/;
use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN );
use Encode qw/find_encoding decode/;
use Cwd qw/getcwd abs_path/;
binmode STDIN, ":utf8";
binmode STDOUT, ":utf8";
binmode STDERR, ":utf8";

my $sp; # socket path to be deleted by sig
local $|=1;
my $enc=Encode::find_encoding("UTF-8");
my $rc;
my $tty=`tty`;
chomp($tty);
undef $tty unless -w $tty;

#            0   1      2 3
# imv_ipc.pl in  [path]
# imv_ipc.pl out0 path  msg
# imv_ipc.pl out1 n     msg

unless(@ARGV){
    say "too few arguments.";
    exit 1;
}

given($ARGV[0]){
    when("in"){
	$SIG{TERM}=$SIG{INT}=$SIG{HUP}=\&delete_event;
	say "#PID:$$";
	$rc=&ipc_in($ARGV[1]);
    }
    when(/out(.+)/){
	my $omode=$1;
	my $m;
	my $s;
	my @ss;
	$m=$ARGV[2];
	$s=$ARGV[1];
	if($omode==1){
	    $s=0 unless defined $s;
	    unless($s=~/\d+/){
		say "server index must be an integer: $s";
		exit 1;
	    }
	    my $sf=&get_sock_dir."/".&get_sock_prefix;
	    if($s>0){
		$s=$sf."-$s";
	    }else{
		@ss=glob($sf."*");
		unless(@ss){
		    say "no server seems alive";
		    exit 1;
		}
		unless(defined($m)){
		    say join("\n",@ss);
		    exit 0;
		}
		undef $s;
	    }
	}
	push @ss, $s if defined $s;
	$m="" unless defined $m;
	foreach(@ss){
	    $s=&open_uds($_);
	    unless(defined($s)){
		say "Can't connect to the server via $_: $!";
		$rc=1;
		next;
	    }
	    say "connected to the server via: $_";
	    if($m=~/^\+(.*)/){
		my $opt=$1;
		$opt="" unless defined $opt;
		for(my $i=3;$i<=$#ARGV;$i++){
		    my $f=abs_path($enc->decode($ARGV[$i]));
		    $rc=&ipc_out($s,"\cO".$f);
		}
		$rc=&ipc_out($s,"\cZ$opt");
	    }elsif($m eq "-"){
		$rc=0;
		while(1){
		    print "$_ << ";
		    my $x=<STDIN>;
		    last unless defined $x;
		    chomp($x);
		    $x=~s/^\s*(.*?)\s*$/$1/;
		    next unless $x;
		    last if $x eq "exit";
		    my $opt;
		    if(substr($x,0,1)=~/^\+(\S*)\s+(.*)/){
			$opt=$1;
			$x=$2;
			next unless $x;
			$x="\cO".$x;
			$opt="" unless defined $opt;
		    }
		    $rc=&ipc_out($s,$enc->decode($x));
		    say $rc?"$rc":"ok";
		    &ipc_out($s,"\cZ$opt") if substr($x,0,1) eq "\cO";
		}
		$s->close;
		exit $rc;
	    }else{
		$rc=&ipc_out($s,$enc->decode($m));
	    }
	    $s->close();
	    say "ok" if $rc==0;
	}
    }
    default{
	$rc=1;
    }
}
exit $rc;

sub delete_event
{
    unlink $sp if defined $sp;
    exit 3;
}

sub hello{
    return 0;
}

sub open_uds
{
#    say "opening socket: $_[0]";
    return IO::Socket::UNIX->new(
	Type => SOCK_STREAM,
	Peer => $_[0]);
}

sub create_uds
{
#    say "creating socket: $_[0]";
    return IO::Socket::UNIX->new(
	Type   => SOCK_STREAM,
	Local  => $_[0],
	Listen => SOMAXCONN);
}

sub ipc_out
{
    my ($socket,$msg) = @_;
    my $rc;
    $msg="#TTY:".$tty.":".$msg if defined $tty;
    if(say $socket $msg){ # exits if failed
#	say "sent: ".$enc->decode($msg);
	$socket->flush();
	my $line=<$socket>;
	if(defined($line)){
	    chomp($line);
	    $line=$enc->decode($line);
	    say $1 if $line=~/^#REP:(.+)/;
#	    say "Got: $line" if defined $line;
	    $rc=0;
	}else{
	    say "no response.";
	    $rc=1;
	}
    }else{
	say "failed to send.";
	$rc=1;
    }
    return $rc;
}

sub get_sock_prefix
{
    return "imv-".$ENV{"USER"};
}

sub get_sock_dir
{
    if(exists($ENV{"IMVSOCKDIR"})){
	return $ENV{"IMVSOCKDIR"};
    }else{
	return "/tmp";
    }
}

sub get_sock_name
{
    my $i=0;
    my $s=$_[0]; # sockdir
    my $name;
    if(-d $s && -x $s && -w $s){
	$s.="/".&get_sock_prefix;
	while(1){
	    $i++;
	    $name=$s."-".$i;
	    last unless -e $name;
	}
	return $name;
    }
}

sub ipc_in
{
    my $spath=$_[0];
    my $s;
    my $t;
    my $rc;

    $spath=get_sock_name(&get_sock_dir) unless defined $_[0];
    $s=&create_uds($spath);
    return 1 unless defined $s;
    $sp=$spath;
    say "#SOCKNAME:".$sp;

    while(1){
	unless(defined($t=$s->accept())){
	    $s->close();
	    undef $s;
	    print "failed to accept connection: $!\n";
	    return 2;
	}
	while(1){
	    $rc=&read_uds($t);
	    last if $rc != 0;
	}
	$t->close();
	undef $t;
	last if $rc == -1;
    }
    $s->close();
    undef $s;
    unlink($spath);
    undef $sp;
    return 3;
}

sub read_uds
{
    my $socket=$_[0];
#    say "reading from socket: ",$socket;
    my $line = <$socket>;
    if(defined($line)){
	chomp($line);
	my $com;
	$line=$enc->decode($line);
	if($line=~/^#TTY:[^:]+:(.*)/){
	    $com=$1;
	}else{
	    $com=$line;
	}
	given($com){
	    when("Hi"){
		say "Hi";
		say $socket "#REP:Hi";
	    }
	    when("QUIT"){
		say "bye";
		say $socket "#REP:bye";
		return -1;
	    }
	    when("PSOC"){
		say $socket "#REP:".$sp;
	    }
	    when("PPID"){
		say $socket "#REP:".$$;
	    }
	    when("PPPID"){
		say $socket "#REP:".$ENV{"IMVPID"};
	    }
	    default{
		$line="#IPCIN:".$line;
		say $line;
		say $socket "sent: ".$enc->encode($line);
	    }
	}
    }
    return 1 if $socket->eof;
    return 0;
}
